Covid API provided by UK government
library(ukcovid19)
query_filters <- c(
'areaType=nation',
'areaName=England'
)
cases_and_deaths = list(
date = "date",
cumCasesBySpecimenDateRate = "cumCasesBySpecimenDateRate",
cumDeaths28DaysByDeathDate = "cumDeaths28DaysByDeathDate"
)
df <- get_data(
filters = query_filters,
structure = cases_and_deaths
)
library(ggplot2)
library(tidyverse)
library("drc")
library(plotly)
# set functions to convert to days
toDays <- function(x){
day <- ceiling((as.numeric(x) - min(as.numeric(x)))/86400)
return(day)
}
df$date <- as.POSIXct(df$date)
df = na.omit(df)
Overview - Up-todate Covid Situation
startDate = "2021-03-01"
endDate = "2021-7-27"
filter <- (df$date >= startDate)&(df$date <= endDate)
x <- df[filter,] %>%
ggplot(aes(x = date, y = cumDeaths28DaysByDeathDate)) +
geom_line(color = "blue") +
ylab("cumulative death") +
theme(panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_rect(fill = "#fafafa"),
plot.background = element_rect(fill = "white")
)
ggplotly(x, tooltip = c("date"))
Select Time Periord For Analysis
startDate = "2021-02-23"
endDate = "2021-7-26"
cutPoint = "2021-05-23"
filter1 <- (df$date >= startDate)&(df$date <= endDate)
block1 <- df[filter1,]
block1$day = toDays(block1$date)
ts <- subset(block1, date < cutPoint , c(date, day, cumDeaths28DaysByDeathDate))
vs <- subset(block1, date >= cutPoint, c(date, day, cumDeaths28DaysByDeathDate))
ts
#Weibull <- drm(cumDeaths28DaysByDeathDate ~ day, fct = W1.3(), data = ts)
Viz
#calcuate xlim
ts$cumDeaths28DaysByDeathDate %>%
min() -> ymin
vs$cumDeaths28DaysByDeathDate %>%
max() -> ymax
vs$day %>%
max() -> xmax
with(ts, plot(x = day, y = cumDeaths28DaysByDeathDate,
xlim = c(0, xmax), main = "Validation",
ylim = c(ymin,ymax), col = "grey51", type = "h",
xlab = "Days since day 0",
ylab = "Cumulative Death")
)
with(vs, points(x = day, y = cumDeaths28DaysByDeathDate, col = "grey87", type = "h"))

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCmVkaXRvcl9vcHRpb25zOiAKICBjaHVua19vdXRwdXRfdHlwZTogaW5saW5lCi0tLQoKIyBDb3ZpZCBBUEkgcHJvdmlkZWQgYnkgVUsgZ292ZXJubWVudApgYGB7cn0KbGlicmFyeSh1a2NvdmlkMTkpCnF1ZXJ5X2ZpbHRlcnMgPC0gYygKICAnYXJlYVR5cGU9bmF0aW9uJywKICAnYXJlYU5hbWU9RW5nbGFuZCcKKQpjYXNlc19hbmRfZGVhdGhzID0gbGlzdCgKICBkYXRlID0gImRhdGUiLAogIGN1bUNhc2VzQnlTcGVjaW1lbkRhdGVSYXRlID0gImN1bUNhc2VzQnlTcGVjaW1lbkRhdGVSYXRlIiwKICBjdW1EZWF0aHMyOERheXNCeURlYXRoRGF0ZSA9ICJjdW1EZWF0aHMyOERheXNCeURlYXRoRGF0ZSIKKQoKZGYgPC0gZ2V0X2RhdGEoCiAgZmlsdGVycyA9IHF1ZXJ5X2ZpbHRlcnMsIAogIHN0cnVjdHVyZSA9IGNhc2VzX2FuZF9kZWF0aHMKKQpgYGAKCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkoZ2dwbG90MikKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoImRyYyIpCmxpYnJhcnkocGxvdGx5KQpgYGAKCmBgYHtyfQojIGRlZmluZSBhIGZ1bmN0aW9ucyB0byBjb252ZXJ0IHRvIGRheXMgCnRvRGF5cyA8LSBmdW5jdGlvbih4KXsKIGRheSA8LSAgY2VpbGluZygoYXMubnVtZXJpYyh4KSAtIG1pbihhcy5udW1lcmljKHgpKSkvODY0MDApCiByZXR1cm4oZGF5KQp9CgpkZiRkYXRlIDwtIGFzLlBPU0lYY3QoZGYkZGF0ZSkKZGYgPSBuYS5vbWl0KGRmKQpgYGAKCiMgT3ZlcnZpZXcgLSBVcC10b2RhdGUgQ292aWQgU2l0dWF0aW9uCmBgYHtyfQpzdGFydERhdGUgPSAiMjAyMS0wMy0wMSIKZW5kRGF0ZSA9ICIyMDIxLTctMjciCgpmaWx0ZXIgPC0gKGRmJGRhdGUgPj0gc3RhcnREYXRlKSYoZGYkZGF0ZSA8PSBlbmREYXRlKQp4IDwtIGRmW2ZpbHRlcixdICU+JQogIGdncGxvdChhZXMoeCA9IGRhdGUsIHkgPSBjdW1EZWF0aHMyOERheXNCeURlYXRoRGF0ZSkpICsgCiAgZ2VvbV9saW5lKGNvbG9yID0gImJsdWUiKSArIAogIHlsYWIoImN1bXVsYXRpdmUgZGVhdGgiKSArIAogIHRoZW1lKHBhbmVsLmJvcmRlciA9IGVsZW1lbnRfYmxhbmsoKSwKICAgICAgICAgIHBhbmVsLmdyaWQubWFqb3IgPSBlbGVtZW50X2JsYW5rKCksCiAgICAgICAgICBwYW5lbC5ncmlkLm1pbm9yID0gZWxlbWVudF9ibGFuaygpLAogICAgICAgICAgcGFuZWwuYmFja2dyb3VuZCA9IGVsZW1lbnRfcmVjdChmaWxsID0gIiNmYWZhZmEiKSwKICAgICAgICAgIHBsb3QuYmFja2dyb3VuZCA9IGVsZW1lbnRfcmVjdChmaWxsID0gIndoaXRlIikKICAgICAgICApCmdncGxvdGx5KHgsIHRvb2x0aXAgPSBjKCJkYXRlIikpCmBgYAoKCgojIFNlbGVjdCBUaW1lIFBlcmlvcmQgRm9yIEFuYWx5c2lzCmBgYHtyfQpzdGFydERhdGUgPSAiMjAyMS0wMi0yMyIKZW5kRGF0ZSA9ICIyMDIxLTctMjYiCgpjdXRQb2ludCA9ICIyMDIxLTA1LTIzIgoKZmlsdGVyMSA8LSAoZGYkZGF0ZSA+PSBzdGFydERhdGUpJihkZiRkYXRlIDw9IGVuZERhdGUpCmJsb2NrMSA8LSBkZltmaWx0ZXIxLF0KYmxvY2sxJGRheSA9IHRvRGF5cyhibG9jazEkZGF0ZSkKCnRzIDwtIHN1YnNldChibG9jazEsIGRhdGUgPCBjdXRQb2ludCAsIGMoZGF0ZSwgZGF5LCBjdW1EZWF0aHMyOERheXNCeURlYXRoRGF0ZSkpCnZzIDwtIHN1YnNldChibG9jazEsIGRhdGUgPj0gY3V0UG9pbnQsIGMoZGF0ZSwgZGF5LCBjdW1EZWF0aHMyOERheXNCeURlYXRoRGF0ZSkpCnRzCgojV2VpYnVsbCA8LSBkcm0oY3VtRGVhdGhzMjhEYXlzQnlEZWF0aERhdGUgfiBkYXksIGZjdCA9IFcxLjMoKSwgZGF0YSA9IHRzKQpgYGAKIyMgVml6CmBgYHtyfQojY2FsY3VhdGUgeGxpbQp0cyRjdW1EZWF0aHMyOERheXNCeURlYXRoRGF0ZSAlPiUKICBtaW4oKSAtPiB5bWluCnZzJGN1bURlYXRoczI4RGF5c0J5RGVhdGhEYXRlICU+JQogIG1heCgpIC0+IHltYXgKdnMkZGF5ICU+JQogIG1heCgpIC0+IHhtYXgKd2l0aCh0cywgcGxvdCh4ID0gZGF5LCB5ID0gY3VtRGVhdGhzMjhEYXlzQnlEZWF0aERhdGUsIAogICAgICAgICAgICAgIHhsaW0gPSBjKDAsIHhtYXgpLCBtYWluID0gIlZhbGlkYXRpb24iLAogICAgICAgICAgICB5bGltID0gYyh5bWluLHltYXgpLCBjb2wgPSAiZ3JleTUxIiwgdHlwZSA9ICJoIiwKICAgICAgICAgICAgeGxhYiA9ICJEYXlzIHNpbmNlIGRheSAwIiwKICAgICAgICAgICAgeWxhYiA9ICJDdW11bGF0aXZlIERlYXRoIikKICApCndpdGgodnMsIHBvaW50cyh4ID0gZGF5LCB5ID0gY3VtRGVhdGhzMjhEYXlzQnlEZWF0aERhdGUsIGNvbCA9ICJncmV5ODciLCB0eXBlID0gImgiKSkKYGBgCgoK